home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / wgsave11.zip / SCRNSAV2.PAS < prev    next >
Pascal/Delphi Source File  |  1993-07-13  |  12KB  |  292 lines
  1. {$A+,B-,D+,E+,F+,G-,I+,L+,N-,O-,R+,S+,V+,X-}
  2. {$M 8192,0,655360}
  3.  
  4. {File : SCRNSAV2.PAS, Vs. 1.1, for TP 7.0.
  5.  
  6.  Test of screen saver.
  7.  This is only a simple example, don't expect too much.
  8.  Look for all lines with +++ comment.
  9.  
  10.  The Init, GetEvent, HandleEvent and Idle method of TApplication
  11.  need changes.
  12.  
  13.  This program does not disable TV GetEvent while in screen saver mode,
  14.  but see SCRNSAV1.PAS. It also works if modal dialogs are pending.
  15.  In some cases people might want to eat away key strokes which revoked
  16.  the program from screen saver mode. Do this in GetEvent.
  17.  
  18.  Problem:  If a subview of TApplication has its own GetEvent then the
  19.            screen saver might not know when to stop!! See SCRNSAV3.PAS
  20.            on how to tackle this problem.
  21.  
  22.  Warning: There is a call to Randomize at invocation of the screen
  23.           saver. This might interfere with other parts of your program.
  24.           Take care of checking boolean var ScreenSaverMode in
  25.           your Idle routine (see below).
  26.  
  27.  If the mechanism to invoke the screen server is ok for you, then just
  28.  put your favorite flashy wonderful screen saver into the Idle method.
  29.  
  30.  
  31.  Hacked on 30-JUN-93 by Wolfgang Gross, gross@aecds.exchi.uni-heidelberg.de
  32.  Comments by Rutger van de GeVEL, rutger@kub.nl.
  33.  
  34.  Changed: 13-JUL-93   bugs, minor improvements
  35.  
  36.  }
  37.  
  38.  
  39. program TestScreenSaver;
  40.   uses CRT,DOS,Objects,memory,Drivers,Views,Menus,Dialogs,App,gadgets,msgbox;
  41.  
  42.   const
  43.     cmAboutDialog = 101;
  44.     cmTestDialog  = 102;
  45.  
  46.     {change these constants as convenient                            +++}
  47.     cmStartScrnSaver = 200;                                         {+++}
  48.     cmStopScrnSaver  = 201;                                         {+++}
  49.     {your favorite text here}
  50.     ScrnSaverText : String = 'Screen saver test lurking ...' ;      {+++}
  51.     GracePeriod : longint = 5000; {ask DOS time after graceperiod}  {+++}
  52.     {all time values in centiseconds                                 +++}
  53.     {Invoke screen saver after program is idle for ScrnSaverDelay centisecs.
  54.      Text stays on screen for ScnrSaverPeriod centisecs. }
  55.     ScrnSaverDelay  : longint = 500;                                {+++}
  56.     ScrnSaverPeriod : longint = 500;                                {+++}
  57.  
  58.   type
  59.  
  60.     TMyApp = object(TApplication)
  61.       ScrnSaverKickTime,                                            {+++}
  62.       ScrnSaverLastTime : longint; {centiseconds}                   {+++}
  63.       ScrnSaverMode : boolean;                                      {+++}
  64.       GraceCounter : word; {ask DOS time only if > GracePeriod}     {+++}
  65.  
  66.       Heap: PHeapView; Clock : PClockView;
  67.       constructor init;
  68.       procedure getevent( VAR event : TEvent ); virtual;
  69.       procedure HandleEvent(var Event: TEvent); virtual;
  70.       procedure InitMenuBar; virtual;
  71.       procedure InitStatusLine; virtual;
  72.       procedure AboutDialog;
  73.       procedure TestDialog;
  74.       procedure Idle;virtual;
  75.     end;
  76.  
  77.  
  78. FUNCTION Time:longint;                     {+++ we need this function +++}
  79.   {Return real day time in centiseconds. One might get in trouble with
  80.    measurements spanning midnight. Smallest reliable interval: 55 msec}
  81.   VAR Hour,Minute,Second,Sec100: WORD;                               {+++}
  82.   BEGIN                                                              {+++}
  83.     GetTime(Hour,Minute,Second,Sec100);                              {+++}
  84.     Time:=longint(Sec100)+100*(longint(Second)                       {+++}
  85.           +60*(longint(Minute)+60*longint(hour)));                   {+++}
  86.   END;                                                               {+++}
  87.  
  88.  
  89. CONSTRUCTOR TMyApp.Init;
  90.   VAR R : TRect;
  91.   BEGIN
  92.  
  93.     TApplication.Init;
  94.  
  95.     ScrnSaverKickTime := 0;                                          {+++}
  96.     ScrnSaverLastTime := 0;                                          {+++}
  97.     ScrnSaverMode := false;                                          {+++}
  98.     GraceCounter :=0;                                                {+++}
  99.  
  100.     GetExtent(R);
  101.     R.A.X := R.B.X - 9; R.B.Y := R.A.Y + 1;
  102.     Clock := New(PClockView, Init(R));
  103.     Insert(Clock);
  104.  
  105.     GetExtent(R);
  106.     Dec(R.B.X);
  107.     R.A.X := R.B.X - 9; R.A.Y := R.B.Y - 1;
  108.     Heap := New(PHeapView, Init(R));
  109.     Insert(Heap);
  110.  
  111.   END; {PROC TMyApp.Init}
  112.  
  113.  
  114.   procedure TMyApp.GetEvent ( VAR Event : TEvent );
  115.     VAR p : pointer; SEvent : TEvent;
  116.     BEGIN
  117.       {--> your events before TV, eg. COM input}
  118.       inherited GetEvent(Event);
  119.       {--> your events after TV}
  120.  
  121.       {we must call HandleEvent explicitly since a pending modal dialog
  122.        will otherwise eat the cmStart/StopScrnSaver event.}
  123.       {reset counter if event pending but do not kill this event      +++}
  124.       IF Event.What<>evNothing THEN                                  {+++}
  125.         BEGIN                                                        {+++}
  126.           GraceCounter := 0; ScrnSaverKickTime := 0;                 {+++}
  127.           IF ScrnSaverMode THEN                                      {+++}
  128.             BEGIN                                                    {+++}
  129.               SEvent.What := evcommand;                              {+++}
  130.               SEvent.command := cmStopScrnSaver;                     {+++}
  131.               HandleEvent(SEvent);                                   {+++}
  132.               Exit;                                                  {+++}
  133.             END;                                                     {+++}
  134.         END;                                                         {+++}
  135.  
  136.       IF NOT ScrnSaverMode THEN                                      {+++}
  137.        IF GraceCounter < GracePeriod    {start calling DOS time after +++}
  138.         THEN Inc(GraceCounter)          {grace period since it's too  +++}
  139.         ELSE                            {time consuming.              +++}
  140.           BEGIN
  141.             IF ScrnSaverKickTime=0 THEN ScrnSaverKickTime := Time;   {+++}
  142.             IF (Abs(Time-ScrnSaverKickTime)>ScrnSaverDelay) THEN     {+++}
  143.               BEGIN                                                  {+++}
  144.                 SEvent.What := evcommand;                            {+++}
  145.                 SEvent.command := cmStartScrnSaver;                  {+++}
  146.                 HandleEvent(SEvent);                                 {+++}
  147.                 Exit;                                                {+++}
  148.              END;                                                    {+++}
  149.           END;                                                       {+++}
  150.  
  151.     END; {PROC TMyApp.GetEvent}
  152.  
  153.  
  154.   procedure TMyApp.HandleEvent(var Event: TEvent);
  155.  
  156.     begin {HandleEvent}
  157.  
  158.       inherited HandleEvent(Event);
  159.  
  160.       if (Event.What = evCommand) then
  161.          begin
  162.            case Event.Command of
  163.             cmAboutDialog :
  164.                AboutDialog;
  165.             cmTestDialog :
  166.                TestDialog;
  167.             cmStartScrnSaver :                                   {+++}
  168.                BEGIN                                             {+++}
  169.                  Randomize;                                      {+++}
  170.                  ScrnSaverLastTime := 0;                         {+++}
  171.                  ScrnSaverMode := true;                          {+++}
  172.                  TextBackGround(Black);                          {+++}
  173.                END;                                              {+++}
  174.             cmStopScrnSaver :                                    {+++}
  175.                BEGIN                                             {+++}
  176.                  ScrnSaverMode := false;                         {+++}
  177.                  ScrnSaverKickTime := 0; GraceCounter := 0;      {+++}
  178.                  inherited redraw;                               {+++}
  179.                END;                                              {+++}
  180.             else
  181.  
  182.                Exit;
  183.            end;
  184.            ClearEvent(Event);
  185.          end
  186.  
  187.     end;  {HandleEvent}
  188.  
  189. PROCEDURE TMyApp.Idle;
  190.   BEGIN
  191.     inherited Idle;                       {+++ do this in ScrnSaverMode ???}
  192.  
  193.     IF ScrnSaverMode                                                   {+++}
  194.       THEN                                                             {+++}
  195.         BEGIN                                                          {+++}
  196.           IF (Abs(Time-ScrnSaverLastTime)>ScrnSaverPeriod) THEN        {+++}
  197.             BEGIN                                                      {+++}
  198.               ClrScr;                                                  {+++}
  199.               TextColor(Random(14)+1);                                 {+++}
  200.               Gotoxy ( Random(80-length(ScrnSaverText)), Random(24));  {+++}
  201.               write ( ScrnSaverText ); ScrnSaverLastTime := Time;      {+++}
  202.             END;                                                       {+++}
  203.         END                                                            {+++}
  204.       ELSE                                                             {+++}
  205.         BEGIN                                                          {+++}
  206.           Heap^.Update; Clock^.Update;                                 {+++}
  207.         END;                                                           {+++}
  208.  
  209.   END;{PROC TMyApp.Idle}
  210.  
  211.  
  212.   procedure TMyApp.InitMenuBar;
  213.     VAR R : TRect;
  214.     begin {InitMenuBar}
  215.       GetExtent(R);
  216.       R.B.Y := R.A.Y+1;
  217.       MenuBar := New(PMenuBar, Init(R, NewMenu(
  218.         NewSubMenu('~'#240'~', 1000, NewMenu(
  219.           NewItem('~A~bout', '', kbNoKey, cmAboutDialog, 1001,nil)),
  220.         NewSubMenu('~F~ile', 1100, NewMenu(
  221.           NewItem('~T~estDialog', '', kbF3, cmTestDialog, 1010,
  222.           NewLine(
  223.           NewItem('E~x~it', '', kbAltx, cmquit, 1020,nil)))),
  224.       nil)))));
  225.     end;  {PROC TMyApp.InitMenuBar}
  226.  
  227.  
  228.   procedure TMyApp.InitStatusLine;
  229.     var   R : TRect;
  230.     begin  {InitStatusLine}
  231.       GetExtent(R);
  232.       R.A.Y := R.B.Y - 1;
  233.       StatusLine := New(PStatusLine,Init(R,
  234.         NewStatusDef(0,$FFFF,
  235.           NewStatusKey('',kbF10,cmMenu,
  236.           NewStatusKey('~Alt-X~ Exit',kbAltX,cmQuit,
  237.           NewStatusKey('~F3~ Testbox',kbF3,cmTestDialog,
  238.           nil))),
  239.         nil)
  240.       ));
  241.     end; {PROC TMyApp.InitStatusLine}
  242.  
  243.  
  244.   procedure TMyApp.AboutDialog;
  245.     var  D : PDialog;
  246.          R : TRect;
  247.          Control : PView;
  248.          C : word;
  249.     begin {AboutDialog}
  250.       R.Assign(0, 0, 40, 11);
  251.       D := New(PDialog, Init(R, 'About'));
  252.       with D^ do
  253.         begin
  254.           Options := Options or ofCentered;
  255.  
  256.           R.Grow(-1, -1);
  257.           Dec(R.B.Y, 3);
  258.           Insert(New(PStaticText, Init(R,
  259.           #13 + ^C'Turbo Vision Screen Saver Demo'#13 +
  260.           #13 + ^C'GetEvent in effect.'#13 +
  261.           #13 + ^C'W. Gross 1993'#13 )));
  262.  
  263.           R.Assign(15, 8, 25, 10);
  264.           Insert(New(PButton, Init(R, 'O~K', cmOk, bfDefault)));
  265.          end;
  266.       if ValidView(D) <> nil then
  267.         begin
  268.           c := Desktop^.ExecView(D);
  269.           Dispose(D, Done);
  270.         end;
  271.     end;  {PROC TMyApp.
  272.     AboutDialog}
  273.  
  274.   procedure TMyApp.TestDialog;
  275.     var D: PDialog;
  276.         c : word;
  277.     begin
  278.       c := messagebox ( 'This is just a dummy dialog.', nil,
  279.                         mfinformation+mfOkbutton );
  280.     end;  {PROC TMyApp.TestDialog}
  281.  
  282.  
  283.   var
  284.     MyApp : TMyApp;
  285.  
  286.  
  287. begin {SCRNSAV2}
  288.   MyApp.Init;
  289.   MyApp.Run;
  290.   MyApp.Done;
  291. end.  {SCRNAV2}
  292.